home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / qbprog.EXE / CAL.BAS < prev    next >
BASIC Source File  |  1993-12-05  |  5KB  |  182 lines
  1. DEFINT A-Z               ' Default variable type is integer
  2.  
  3. ' Define a data type for the names of the months and the
  4. ' number of days in each:
  5. TYPE MonthType
  6.    Number AS INTEGER     ' Number of days in the month
  7.    MName AS STRING * 9   ' Name of the month
  8. END TYPE
  9.  
  10. ' Declare procedures used:
  11. DECLARE FUNCTION IsLeapYear% (N%)
  12. DECLARE FUNCTION GetInput% (Prompt$, Row%, LowVal%, HighVal%)
  13.  
  14. DECLARE SUB PrintCalendar (Year%, Month%)
  15. DECLARE SUB ComputeMonth (Year%, Month%, StartDay%, TotalDays%)
  16.  
  17. DIM MonthData(1 TO 12) AS MonthType
  18.  
  19. ' Initialize month definitions from DATA statements below:
  20. FOR I = 1 TO 12
  21.    READ MonthData(I).MName, MonthData(I).Number
  22. NEXT
  23.  
  24. ' Main loop, repeat for as many months as desired:
  25. DO
  26.  
  27.    CLS
  28.  
  29.    ' Get year and month as input:
  30.    Year = GetInput("Year (1899 to 2099): ", 1, 1899, 2099)
  31.    Month = GetInput("Month (1 to 12): ", 2, 1, 12)
  32.  
  33.    ' Print the calendar:
  34.    PrintCalendar Year, Month
  35.  
  36.    ' Another Date?
  37.    LOCATE 13, 1         ' Locate in 13th row, 1st column
  38.    PRINT "New Date? ";  ' Keep cursor on same line
  39.    LOCATE , , 1, 0, 13  ' Turn cursor on and make it one
  40.                         ' character high
  41.    Resp$ = INPUT$(1)    ' Wait for a key press
  42.    PRINT Resp$          ' Print the key pressed
  43.  
  44. LOOP WHILE UCASE$(Resp$) = "Y"
  45. END
  46.  
  47. ' Data for the months of a year:
  48. DATA January, 31, February, 28, March, 31
  49. DATA April, 30, May, 31, June, 30, July, 31, August, 31
  50. DATA September, 30, October, 31, November, 30, December, 31
  51.  
  52. '
  53. ' ====================== COMPUTEMONTH ========================
  54. '     Computes the first day and the total days in a month.
  55. ' ============================================================
  56. '
  57. SUB ComputeMonth (Year, Month, StartDay, TotalDays) STATIC
  58.    SHARED MonthData() AS MonthType
  59.    CONST LEAP = 366 MOD 7
  60.    CONST NORMAL = 365 MOD 7
  61.  
  62.    ' Calculate total number of days (NumDays) since 1/1/1899.
  63.  
  64.    ' Start with whole years:
  65.    NumDays = 0
  66.    FOR I = 1899 TO Year - 1
  67.       IF IsLeapYear(I) THEN         ' If year is leap, add
  68.          NumDays = NumDays + LEAP   ' 366 MOD 7.
  69.       ELSE                          ' If normal year, add
  70.          NumDays = NumDays + NORMAL ' 365 MOD 7.
  71.       END IF
  72.    NEXT
  73.  
  74.    ' Next, add in days from whole months:
  75.    FOR I = 1 TO Month - 1
  76.       NumDays = NumDays + MonthData(I).Number
  77.    NEXT
  78.  
  79.    ' Set the number of days in the requested month:
  80.    TotalDays = MonthData(Month).Number
  81.  
  82.    ' Compensate if requested year is a leap year:
  83.    IF IsLeapYear(Year) THEN
  84.  
  85.       ' If after February, add one to total days:
  86.       IF Month > 2 THEN
  87.          NumDays = NumDays + 1
  88.  
  89.       ' If February, add one to the month's days:
  90.       ELSEIF Month = 2 THEN
  91.          TotalDays = TotalDays + 1
  92.  
  93.       END IF
  94.    END IF
  95.  
  96.    ' 1/1/1899 was a Sunday, so calculating "NumDays MOD 7"
  97.    ' gives the day of week (Sunday = 0, Monday = 1, Tuesday = 2,
  98.    ' and so on) for the first day of the input month:
  99.    StartDay = NumDays MOD 7
  100. END SUB
  101.  
  102. '
  103. ' ======================== GETINPUT ==========================
  104. '       Prompts for input, then tests for a valid range.
  105. ' ============================================================
  106. '
  107. FUNCTION GetInput (Prompt$, Row, LowVal, HighVal) STATIC
  108.  
  109.    ' Locate prompt at specified row, turn cursor on and
  110.    ' make it one character high:
  111.    LOCATE Row, 1, 1, 0, 13
  112.    PRINT Prompt$;
  113.  
  114.    ' Save column position:
  115.    Column = POS(0)
  116.  
  117.    ' Input value until it's within range:
  118.    DO
  119.       LOCATE Row, Column   ' Locate cursor at end of prompt
  120.       PRINT SPACE$(10)     ' Erase anything already there
  121.       LOCATE Row, Column   ' Relocate cursor at end of prompt
  122.       INPUT "", Value      ' Input value with no prompt
  123.    LOOP WHILE (Value < LowVal OR Value > HighVal)
  124.  
  125.    ' Return valid input as value of function:
  126.    GetInput = Value
  127.  
  128. END FUNCTION
  129.  
  130. '
  131. ' ====================== ISLEAPYEAR ==========================
  132. '         Determines if a year is a leap year or not.
  133. ' ============================================================
  134. '
  135. FUNCTION IsLeapYear (N) STATIC
  136.  
  137.    ' If the year is evenly divisible by 4 and not divisible
  138.    ' by 100, or if the year is evenly divisible by 400, then
  139.    ' it's a leap year:
  140.    IsLeapYear = (N MOD 4 = 0 AND N MOD 100 <> 0) OR (N MOD 400 = 0)
  141. END FUNCTION
  142.  
  143. '
  144. ' ===================== PRINTCALENDAR ========================
  145. '     Prints a formatted calendar given the year and month.
  146. ' ============================================================
  147. '
  148. SUB PrintCalendar (Year, Month) STATIC
  149. SHARED MonthData() AS MonthType
  150.  
  151.    ' Compute starting day (Su M Tu ...) and total days
  152.    ' for the month:
  153.    ComputeMonth Year, Month, StartDay, TotalDays
  154.    CLS
  155.    Header$ = RTRIM$(MonthData(Month).MName) + "," + STR$(Year)
  156.  
  157.    ' Calculates location for centering month and year:
  158.    LeftMargin = (35 - LEN(Header$)) \ 2
  159.  
  160.    ' Print header:
  161.    PRINT TAB(LeftMargin); Header$
  162.    PRINT
  163.    PRINT "Su    M   Tu    W   Th    F   Sa"
  164.    PRINT
  165.  
  166.    ' Recalculate and print tab to the first day
  167.    ' of the month (Su M Tu ...):
  168.    LeftMargin = 5 * StartDay + 1
  169.    PRINT TAB(LeftMargin);
  170.  
  171.    ' Print out the days of the month:
  172.    FOR I = 1 TO TotalDays
  173.       PRINT USING "##   "; I;
  174.  
  175.       ' Advance to the next line when the cursor
  176.       ' is past column 32:
  177.       IF POS(0) > 32 THEN PRINT
  178.    NEXT
  179.  
  180. END SUB
  181.  
  182.